home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / POINTERS.SWG / 0002_How can I create a big array (>64K RAM).pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  31.2 KB  |  700 lines
  1.  
  2. 1) use pointer
  3. 2) use XMS or EMS
  4.  
  5.  
  6. 1) Pointer
  7. ***************************************
  8.  
  9.  
  10. Type                      {**}
  11.           Data = Array[1..2000] of Real;   { Data size must not exceed 64K }
  12.           DataPtr = ^Data;
  13. Const
  14.           MaxVar = 20;        { Value of MaxVar can be anything }
  15.                               { but you must have sufficient heap memory }
  16.                               {                   ^^^^^^^^^^^^^^^^^^^^^^ }
  17. Var
  18.           Variable :Array[1..MaxVar] of DataPtr;
  19.  
  20.  
  21. PROCEDURE AllocateVar;
  22. Var
  23.           i      :Word;
  24. Begin
  25.   If MaxAvail >= MaxVar*6*2000 Then     { Check Heap before allocate }
  26.     For i := 1 to MaxVar do
  27.       New (Variable[i])
  28.   Else Begin
  29.     Writeln ('This progam requir memory more ',MaxVar*6*2000-MaxAvail);
  30.     Halt (1)
  31.   End
  32. End;
  33.  
  34.  
  35. PROCEDURE ReleaseVar;
  36. Var
  37.           i      :Word;
  38. Begin
  39.   For i := 1 to MaxVar do
  40.     Dispose (Variable[i])
  41. End;
  42.  
  43.  
  44. Begin
  45.   AllocateVar;
  46.   .
  47.   .
  48.  
  49.          Usage Variable :-
  50.  
  51.          Variable[Range1]^[Range2] := Real_Data;
  52.                    /|\      /|\
  53.      1-MaxVar_______|        |______ 1-2000 follow upper declaration {**}
  54.  
  55.      Ex.
  56.              For i := 1 to MaxVar do
  57.                 For j := 1 to 2000 do
  58.                   Variable[i]^[j] := 0;
  59.   .
  60.   .
  61.   ReleaseVar;
  62. End.
  63.  
  64. --------------------------------------------------
  65.  
  66. 2) Use XMS
  67. ***********************************
  68.  
  69.  
  70.  
  71. ( this is include file xms.inc )
  72.                ^^^^^^^    
  73.  
  74. Const
  75.       ERR_NOERR          = $00;         { No error                         }
  76.       ERR_NOTIMPLEMENTED = $80;         { SpecIfied FUNCTION not known     }
  77.       ERR_VDISKFOUND     = $81;         { VDISK-RAMDISK detected           }
  78.       ERR_A20            = $82;         { Error at handler A20             }
  79.       ERR_GENERAL        = $8E;         { General driver error             }
  80.       ERR_UNRECOVERABLE  = $8F;         { Unrecoverable error              }
  81.       ERR_HMANOTEXIST    = $90;         { HMA does not exist               }
  82.       ERR_HMAINUSE       = $91;         { HMA already in use               }
  83.       ERR_HMAMINSIZE     = $92;         { Not enough space in HMA          }
  84.       ERR_HMANOTALLOCED  = $93;         { HMA not allocated                }
  85.       ERR_A20STILLON     = $94;         { Handler A20 still on             }
  86.       ERR_OUTOMEMORY     = $A0;         { Out of extEnded memory           }
  87.       ERR_OUTOHANDLES    = $A1;         { All XMS handles in use           }
  88.       ERR_INVALIDHANDLE  = $A2;         { Invalid handle                   }
  89.       ERR_SHINVALID      = $A3;         { Source handle invalid            }
  90.       ERR_SOINVALID      = $A4;         { Source offset invalid            }
  91.       ERR_DHINVALID      = $A5;         { Destination handle invalid       }
  92.       ERR_DOINVALID      = $A6;         { Destination offset invalid       }
  93.       ERR_LENINVALID     = $A7;         { Invalid length for move FUNCTION }
  94.       ERR_OVERLAP        = $A8;         { Illegal overlapping              }
  95.       ERR_PARITY         = $A9;         { Parity error                     }
  96.       ERR_EMBUNLOCKED    = $AA;         { UMB is unlocked                  }
  97.       ERR_EMBLOCKED      = $AB;         { UMB is still locked              }
  98.       ERR_LOCKOVERFLOW   = $AC;         { Overflow of UMB lock counter     }
  99.       ERR_LOCKFAIL       = $AD;         { UMB cannot be locked             }
  100.       ERR_UMBSIZETOOBIG  = $B0;         { Smaller UMB available            }
  101.       ERR_NOUMBS         = $B1;         { No more UMB available            }
  102.       ERR_INVALIDUMB     = $B2;         { Invalid UMB segment address      }
  103.  
  104. Type
  105.       XMSRegs = record                  { Information for XMS call         }
  106.                  AX,                    { Only registers AX, BX, DX and SI }
  107.                  BX,                    { required, depEnding on called    }
  108.                  DX,                    { FUNCTION along With a segment    }
  109.                  SI,                    { address                          }
  110.                  Segment :Word
  111.       End;
  112.  
  113. Var
  114.       XMSPtr :Pointer;      { Pointer to the extEnded memory manager (XMM) }
  115.       XMSErr :Byte;         { Error code of the last operation             }
  116.  
  117. {**********************************************************************
  118. * XMSInitOk : Initializes the routines for calling the XMS FUNCTIONs  *
  119. **-------------------------------------------------------------------**
  120. * Input   : None                                                      *
  121. * Output  : TRUE, If an XMS driver was discovered, otherwise FALSE    *
  122. * Info    : - The call of this FUNCTION must precede calls of all     *
  123. *             all other PROCEDUREs and FUNCTIONs from this program.   *
  124. **********************************************************************}
  125.  
  126. FUNCTION XMSInitOk :Boolean;
  127. Var
  128.         Regs :Registers;
  129.         XR   :XMSRegs;
  130.  
  131. Begin
  132.   Regs.AX := $4300;               { Determine availability of XMS manager }
  133.   Intr ($2F,Regs);
  134.   If (Regs.AL = $80) Then         { XMS manager found?                    }
  135.     Begin                         { Yes                                   }
  136.       Regs.AX := $4310;           { Determine entry point of XMM          }
  137.       Intr ($2F,Regs);
  138.       XMSPtr := ptr (Regs.ES,Regs.BX);      { Store address in glob. Var. }
  139.       XMSErr := ERR_NOERR;                  { Still no error found        }
  140.       XMSInitOk := true;              { Handler found, module initialized }
  141.     End
  142.   Else                                { No XMS handler installed }
  143.    XMSInitOk := false
  144. End;
  145.  
  146. {**********************************************************************
  147. * XMSCall : General routine for calling an XMS FUNCTION               *
  148. **-------------------------------------------------------------------**
  149. * Input   : FctNo = Number of XMS FUNCTION to be called               *
  150. *           XRegs = Structure With registers for FUNCTION call        *
  151. * Info    : - Before calling this PROCEDURE, only those registers     *
  152. *             can be loaded that are actually required for calling    *
  153. *             the specIfied FUNCTION.                                 *
  154. *           - After the XMS FUNCTION call, the contents of the        *
  155. *             Various processor registers are copied to the           *
  156. *             corresponding components of the passed structure.       *
  157. *           - Before calling this PROCEDURE for the first time, the   *
  158. *             XMSInit must be called successfully.                    *
  159. **********************************************************************}
  160.  
  161. PROCEDURE XMSCall (FctNr :Byte; Var XRegs :XMSRegs);
  162. Begin
  163.   inline ( $8C / $D9 /                              { mov    cx,ds        }
  164.            $51 /                                    { push   cx           }
  165.            $C5 / $BE / $04 / $00 /                  { lds    di,[bp+0004] }
  166.            $8A / $66 / $08 /                        { mov    ah,[bp+0008] }
  167.            $8B / $9D / $02 / $00 /                  { mov    bx,[di+0002] }
  168.            $8B / $95 / $04 / $00 /                  { mov    dx,[di+0004] }
  169.            $8B / $B5 / $06 / $00 /                  { mov    si,[di+0006] }
  170.            $8E / $5D / $08 /                        { mov    ds,[di+08]   }
  171.            $8E / $C1 /                              { mov    es,cx        }
  172.            $26 / $FF / $1E / XMSPtr /               { call   es:[XMSPTr]  }
  173.            $8C / $D9 /                              { mov    cx,ds        }
  174.            $C5 / $7E / $04 /                        { lds    di,[bp+04]   }
  175.            $89 / $05 /                              { mov    [di],ax      }
  176.            $89 / $5D / $02 /                        { mov    [di+02],bx   }
  177.            $89 / $55 / $04 /                        { mov    [di+04],dx   }
  178.            $89 / $75 / $06 /                        { mov    [di+06],si   }
  179.            $89 / $4D / $08 /                        { mov    [di+08],cx   }
  180.            $1F                                      { pop    ds           }
  181.         );
  182.  
  183.   {-- Test for error code --------------------------------------------}
  184.  
  185.   If (XRegs.AX = 0) and (XRegs.BX >= 128) Then
  186.     Begin
  187.       XMSErr := Lo(XRegs.BX)                    { Error, store error code }
  188.       {
  189.        .
  190.        .
  191.        .
  192.          Another error handling routine could follow here
  193.        .
  194.        .
  195.        .
  196.       }
  197.     End
  198.   Else
  199.     XMSErr := ERR_NOERR                                { No error, all ok }
  200. End;
  201.  
  202. {**********************************************************************
  203. * XMSQueryVer: Returns the XMS version number and other status        *
  204. *              information                                            *
  205. **-------------------------------------------------------------------**
  206. * Input   : VerNr = Gets the version number after the FUNCTION call   *
  207. *                   (Format: 235 = 2.35)                              *
  208. *           RevNr = Gets the revision number after the FUNCTION call  *
  209. * Output  : TRUE, If HMA is available, otherwise FALSE                *
  210. **********************************************************************}
  211.  
  212. PROCEDURE XMSQueryVerHMA (Var VerNr,RevNr :Integer; Var HMA :Boolean);
  213. Var
  214.         XR :XMSRegs;               { Registers for communication With XMS }
  215.  
  216. Begin
  217.   XmsCall (0,XR);
  218.   VerNr := Hi(XR.AX)*100 + (Lo(XR.AX) shr 4) * 10 + (Lo(XR.AX) and 15);
  219.   RevNr := Hi(XR.BX)*100 + (Lo(XR.BX) shr 4) * 10 + (Lo(XR.BX) and 15);
  220.   HMA := (XR.DX = 1)
  221. End;
  222.  
  223. {**********************************************************************
  224. * XMSGetHMA : Returns right to access the HMA to the caller.          *
  225. **-------------------------------------------------------------------**
  226. * Input   : LenB = Number of bytes to be allocated                    *
  227. * Info    : TSR programs should only request the memory size that     *
  228. *           they actually require, while applications should specIfy  *
  229. *           the value $FFFF.                                          *
  230. * Output  : TRUE, If the HMA could be made available,                 *
  231. *           otherwise FALSE;                                          *
  232. **********************************************************************}
  233.  
  234. FUNCTION XMSGetHMA (LenB :Word) :Boolean;
  235. Var
  236.          XR :XMSRegs;
  237.  
  238. Begin
  239.   XR.DX := LenB;                             { Pass length in DX register }
  240.   XmsCall (1,XR);                            { Call XMS FUNCTION #1       }
  241.   XMSGetHMA := (XMSErr = ERR_NOERR)
  242. End;
  243.  
  244. {**********************************************************************
  245. * XMSReleaseHMA : Releases the HMA, making it possible to pass        *
  246. *                 to other programs.                                  *
  247. **-------------------------------------------------------------------**
  248. * Input   : None                                                      *
  249. * Info    : - Call this PROCEDURE before Ending a program If the      *
  250. *             HMA was allocated beforehand through a call for         *
  251. *             XMSGetHMA, because otherwise the HMA cannot be passed   *
  252. *             to any programs called afterwards.                      *
  253. *           - Calling this PROCEDURE causes the data stored in HAM    *
  254. *             to be lost.                                             *
  255. **********************************************************************}
  256.  
  257. PROCEDURE XMSReleaseHMA;
  258. Var
  259.           XR :XMSRegs;        { Call registers for communication With XMS }
  260.  
  261. Begin
  262.   XmsCall (2,XR)              { Call XMS FUNCTION #2 }
  263. End;
  264.  
  265. {**********************************************************************
  266. * XMSA20OnGlobal: Switches on the A20 handler, making direct access   *
  267. *                 to the HMA possible.                                *
  268. **-------------------------------------------------------------------**
  269. * None    : None                                                      *
  270. * Info    : - For many computers, switching on the A20 handler is a   *
  271. *             relatively time-consuming process. Only call this       *
  272. *             PROCEDURE when it is absolutely necessary.              *
  273. **********************************************************************}
  274.  
  275. PROCEDURE XMSA20OnGlobal;
  276. Var
  277.           XR :XMSRegs;             { Registers for communication With XMS }
  278.  
  279. Begin
  280.   XmsCall (3,XR)                   { Call XMS FUNCTION #3 }
  281. End;
  282.  
  283. {**********************************************************************
  284. * XMSA20OffGlobal: A counterpart to the XMSA20OnGlobal PROCEDURE,     *
  285. *                  this PROCEDURE switches the A20 handler back off,  *
  286. *                  so that direct access to the HMA is no longer      *
  287. *                  possible.                                          *
  288. **-------------------------------------------------------------------**
  289. * Input   : None                                                      *
  290. * Info    : - Always call this PROCEDURE before Ending a program,     *
  291. *             in case the A20 handler was switched on before via a    *
  292. *             a call for XMSA20OnGlobal.                              *
  293. **********************************************************************}
  294.  
  295. PROCEDURE XMSA20OffGlobal;
  296. Var
  297.           XR :XMSRegs;             { Registers for communication With XMS }
  298.  
  299. Begin
  300.   XmsCall (4,XR)                   { Call XMS FUNCTION #4 }
  301. End;
  302.  
  303. {**********************************************************************
  304. * XMSA20OnLocal: See XMSA20OnGlobal                                   *
  305. **-------------------------------------------------------------------**
  306. * Input   : None                                                      *
  307. * Info    : - This local PROCEDURE dIffers from the global PROCEDURE  *
  308. *             in that it only switches on the A20 handler If it       *
  309. *             hasn't already been called.                             *
  310. **********************************************************************}
  311.  
  312. PROCEDURE XMSA20OnLocal;
  313. Var
  314.           XR :XMSRegs;             { Registers for communication With XMS }
  315.  
  316. Begin
  317.   XmsCall (5,XR )                  { Call XMS FUNCTION #5 }
  318. End;
  319.  
  320. {**********************************************************************
  321. * XMSA20OffLocal : See XMSA29OffGlobal                                *
  322. **-------------------------------------------------------------------**
  323. * Input   : None                                                      *
  324. * Info    : - This local PROCEDURE only dIffers from the global       *
  325. *             PROCEDURE in that the A20 handler is only switched      *
  326. *             off If hasn't already happened through a previous       *
  327. *             call.                                                   *
  328. **********************************************************************}
  329.  
  330. PROCEDURE XMSA20OffLocal;
  331. Var
  332.           XR :XMSRegs;             { Registers for communication With XMS }
  333.  
  334. Begin
  335.   XmsCall (6,XR)                   { Call XMS FUNCTION #6 }
  336. End;
  337.  
  338. {**********************************************************************
  339. * XMSIsA20On : Returns the status of the A20 handler                  *
  340. **-------------------------------------------------------------------**
  341. * Input   : None                                                      *
  342. * Output  : TRUE, If A20 handler is on, otherwise FALSE.              *
  343. *           FALSE.                                                    *
  344. **********************************************************************}
  345.  
  346. FUNCTION XMSIsA20On :Boolean;
  347. Var
  348.          XR :XMSRegs;              { Registers for communication With XMS }
  349.  
  350. Begin
  351.   XmsCall (7,XR);                  { Call XMS FUNCTION #7        }
  352.   XMSIsA20On := (XR.AX = 1)        { AX = 1 ---> Handler is free }
  353. End;
  354.  
  355. {**********************************************************************
  356. * XMSQueryFree : Returns the size of free extended memory and the     *
  357. *                largest free block                                   *
  358. **-------------------------------------------------------------------**
  359. * Input   : TotFree: Gets the total size of free extended memory.     *
  360. *           MaxBl  : Gets the size of the largest free block.         *
  361. * Info    : - Both specIfications in kilobytes.                       *
  362. *           - The size of the HMA is not included in the count,       *
  363. *             even If it hasn't yet been assigned to a program.       *
  364. **********************************************************************}
  365.  
  366. PROCEDURE XMSQueryFree (Var TotFree, MaxBl :Integer);
  367. Var
  368.           XR :XMSRegs;             { Registers for communication With XMS }
  369.  
  370. Begin
  371.   XmsCall (8,XR);                  { Call XMS FUNCTION #8 }
  372.   TotFree := XR.AX;                { Total size in AX     }
  373.   MaxBl   := XR.DX                 { Free memory in DX    }
  374. End;
  375.  
  376. {**********************************************************************
  377. * XMSGetMem : Allocates an extended memory block (EMB)                *
  378. **-------------------------------------------------------------------**
  379. * Input   : LenKB : Size of requested block in kilobytes              *
  380. * Output  : Handle for further access to block or 0, If no block      *
  381. *           can be allocated. The appropriate error code would        *
  382. *           also be in the global Variable, XMSErr.                   *
  383. **********************************************************************}
  384.  
  385. PROCEDURE XMSGetMem (LenKb :Integer; Var Handle :Integer);
  386. Var
  387.          XR :XMSRegs;              { Registers for communication With XMS }
  388.  
  389. Begin
  390.   XR.DX := LenKB;                  { Length passed in DX register }
  391.   XmsCall (9,XR);                  { Call XMS FUNCTION #9         }
  392.   Handle := XR.DX                  { Return handle                }
  393. End;
  394.  
  395. {**********************************************************************
  396. * XMSFreeMem : Releases previously allocated extEnded memory block    *
  397. *              (EMB).                                                 *
  398. **-------------------------------------------------------------------**
  399. * Input   : Handle : Handle for access to the block returned when     *
  400. *                    XMSGetMem was called.                            *
  401. * Info    : - The contents of the EMB are irretrievably lost and      *
  402. *             the handle becomes invalid when you call this PROCEDURE.*
  403. *           - Before Ending a program, use this PROCEDURE to release  *
  404. *             all allocated memory areas, so that they can be         *
  405. *             allocated for the next program to be called.            *
  406. **********************************************************************}
  407.  
  408. PROCEDURE XMSFreeMem (Handle :Integer);
  409. Var
  410.           XR :XMSRegs;             { Registers for communication With XMS }
  411.  
  412. Begin
  413.   XR.DX := Handle;                 { Handle passed in DX register }
  414.   XmsCall (10,XR)                  { Call XMS FUNCTION #10        }
  415. End;
  416.  
  417. {**********************************************************************
  418. * XMSCopy : Copies memory areas between extEnded memory and           *
  419. *           conventional memory or Within the two memory groups.      *
  420. **-------------------------------------------------------------------**
  421. * Input   : FrmHandle  : Handle of memory area to be copied.          *
  422. *           FrmOffset  : Offset in block being copied.                *
  423. *           ToHandle   : Handle of memory area to which memory is     *
  424. *                        being copied.                                *
  425. *           ToOffset   : Offset in the target block.                  *
  426. *           LenW       : Number of words to be copied.                *
  427. * Info    : - To include normal memory in the operation, 0 must be    *
  428. *             specIfied as the handle and the segment and offset      *
  429. *             address must be specIfied as the offset in the usual    *
  430. *             form (offset before segment).                           *
  431. **********************************************************************}
  432.  
  433. PROCEDURE XMSCopy (FrmHandle :Integer; FrmOffset :LongInt;
  434.                    ToHandle :Integer; ToOffset :LongInt; LenW :LongInt);
  435. Type
  436.           EMMS = record               { An extEnded memory move structure }
  437.             LenB    :LongInt;         { Number of bytes to be moved       }
  438.             SHandle :Integer;         { Source handle                     }
  439.             SOffset :LongInt;         { Source offset                     }
  440.             DHandle :Integer;         { Destination handle                }
  441.             DOffset :LongInt;         { Destination offset                }
  442.           End;
  443.  
  444. Var
  445.           XR :XMSRegs;             { Registers for communication With XMS }
  446.           Mi :EMMS;                { Gets EEMS                            }
  447.  
  448. Begin
  449.   With Mi do                       { Prepare EMMS first }
  450.     Begin
  451.       LenB := 2 * LenW;
  452.       SHandle := FrmHandle;
  453.       SOffset := FrmOffset;
  454.       DHandle := ToHandle;
  455.       DOffset := ToOffset
  456.     End;
  457.   XR.Si := Ofs(Mi);               { Offset address of EMMS  }
  458.   XR.Segment := Seg(Mi);          { Segment address of EMMS }
  459.   XmsCall (11,XR)                 { Call XMS FUNCTION #11   }
  460. End;
  461.  
  462. {**********************************************************************
  463. * XMSLock : Locks an extEnded memory block from being moved by the    *
  464. *           XMM, returning its absolute address at the same time.     *
  465. **-------------------------------------------------------------------**
  466. * Input   : Handle : Handle of memory area returned during a prev-    *
  467. *                    ious call by XMSGetMem.                          *
  468. * Output  : The linear address of the block of memory.                *
  469. **********************************************************************}
  470.  
  471. FUNCTION XMSLock (Handle :Integer) :LongInt;
  472. Var
  473.          XR :XMSRegs;              { Registers for communication With XMS }
  474.  
  475. Begin
  476.   XR.DX := Handle;                            { Handle of EMB          }
  477.   XmsCall (12,XR);                            { Call XMS FUNCTION #12  }
  478.   XMSLock := longint (XR.DX) shl 16 + XR.BX   { Compute 32 bit address }
  479. End;
  480.  
  481. {**********************************************************************
  482. * XMSUnlock : Releases a locked extEnded memory block again.          *
  483. **-------------------------------------------------------------------**
  484. * Input   : Handle : Handle of memory area returned during a prev-    *
  485. *                    ious call by XMSGetMem.                          *
  486. **********************************************************************}
  487.  
  488. PROCEDURE XMSUnLock (Handle :Integer);
  489.  
  490. Var
  491.           XR :XMSRegs;             { Registers for communication With XMS }
  492.  
  493. Begin
  494.   XR.DX := Handle;                 { Handle of EMB         }
  495.   XmsCall (13,XR);                 { Call XMS FUNCTION #13 }
  496. End;
  497.  
  498. {**********************************************************************
  499. * XMSQueryInfo : Gets Various information about an extEnded memory    *
  500. *                block that has been allocated.                       *
  501. **-------------------------------------------------------------------**
  502. * Input   : Handle : Handle of memory area                            *
  503. *           Lock   : Variable, in which the lock counter is entered   *
  504. *           LenKB  : Variable, in which the length of the block is    *
  505. *                    entered in kilobytes                             *
  506. *           FreeH  : Number of free handles                           *
  507. * Info    : You cannot use this PROCEDURE to find out the start       *
  508. *           address of a memory block, use the XMSLock FUNCTION       *
  509. *           instead.                                                  *
  510. **********************************************************************}
  511.  
  512. PROCEDURE XMSQueryInfo (Handle :Integer; Var Lock, LenKB :Integer;
  513.                         Var FreeH :Integer);
  514. Var
  515.           XR :XMSRegs;             { Registers for communication With XMS }
  516.  
  517. Begin
  518.   XR.DX := Handle;                 { Handle of EMB         }
  519.   XmsCall( 14, XR );               { Call XMS FUNCTION #14 }
  520.   Lock  := Hi( XR.BX );            { Evaluate register     }
  521.   FreeH := Lo( XR.BX );
  522.   LenKB := XR.DX
  523. End;
  524.  
  525. {**********************************************************************
  526. * XMSRealloc : Enlarges or shrinks an extEnded memory block prev-     *
  527. *              iously allocated by XMSGetMem                          *
  528. **-------------------------------------------------------------------**
  529. * Input   : Handle   : Handle of memory area                          *
  530. *           NewLenKB : New length of memory area in kilobytes         *
  531. * Output  : TRUE, If the block was resized, otherwise FALSE           *
  532. * Info    : The specIfied block cannot be locked!                     *
  533. **********************************************************************}
  534.  
  535. FUNCTION XMSRealloc (Handle, NewLenKB :Integer) :Boolean;
  536. Var
  537.          XR :XMSRegs;              { Registers for communication With XMS }
  538.  
  539. Begin
  540.   XR.DX := Handle;                        { Handle of EMB                 }
  541.   XR.BX := NewLenKB;                      { New length in the BX register }
  542.   XmsCall (15,XR);                        { Call XMS FUNCTION #15         }
  543.   XMSRealloc := (XMSErr = ERR_NOERR)
  544. End;
  545.  
  546. {**********************************************************************
  547. * XMSGetUMB : Allocates an upper memory block (UMB).                  *
  548. **-------------------------------------------------------------------**
  549. * Input   : LenPara : Size of area to be allocated in paragraphs      *
  550. *                     of 16 bytes each                                *
  551. *           Seg     : Variable that gets the segment address of       *
  552. *                     the allocated UMB in successful cases           *
  553. *           MaxPara : Variable that specIfies the length of the       *
  554. *                     largest available UMB in unsuccessful cases     *
  555. * Output  : TRUE, If a UMB could be allocated, otherwise FALSE        *
  556. * Info    : Warning! This FUNCTION is not supported by all XMS        *
  557. *                    drivers and is extremely hardware-depEndent.     *
  558. **********************************************************************}
  559.  
  560. FUNCTION XMSGetUMB (LenPara :Integer; Var Seg, MaxPara :Word) :Boolean;
  561. Var
  562.          XR :XMSRegs;              { Registers for communication With XMS }
  563.  
  564. Begin
  565.   XR.DX := LenPara;                          { Desired length to      }
  566.   XmsCall (16,XR);                           { Call XMS FUNCTION #16  }
  567.   Seg := XR.BX;                              { Return segment address }
  568.   MaxPara := XR.DX;                          { Length of largest UMB  }
  569.   XMSGetUMB := (XMSErr = ERR_NOERR)
  570. End;
  571.  
  572. {**********************************************************************
  573. * XMSFreeUMB : Releases UMB previously allocated by XMSGetUMB.        *
  574. **-------------------------------------------------------------------**
  575. * Input   : Seg : Segment address of UMB being released               *
  576. * Info    : Warning! This FUNCTION is not supported by all XMS        *
  577. *                    drivers and is extremely hardware-depEndent.     *
  578. **********************************************************************}
  579.  
  580. PROCEDURE XMSFreeUMB (Var Seg :Word);
  581. Var
  582.           XR :XMSRegs;              { Registers for communication wit XMS }
  583.  
  584. Begin
  585.   XR.DX := Seg;                     { Segment address of UMB to DX }
  586.   XmsCall (17,XR)                   { Call XMS FUNCTION #17        }
  587. End;
  588.  
  589. FUNCTION XMSErrMsg (n :Byte) :String;
  590. Begin
  591.   Case n of
  592.     $00 : XMSErrMsg := 'No error';
  593.     $80 : XMSErrMsg := 'SpecIfied FUNCTION not known';
  594.     $81 : XMSErrMsg := 'VDISK-RAMDISK detected';
  595.     $82 : XMSErrMsg := 'Error at handler A20';
  596.     $8E : XMSErrMsg := 'General driver error';
  597.     $8F : XMSErrMsg := 'Unrecoverable error';
  598.     $90 : XMSErrMsg := 'HMA does not exist';
  599.     $91 : XMSErrMsg := 'HMA already in use';
  600.     $92 : XMSErrMsg := 'Not enough space in HMA';
  601.     $93 : XMSErrMsg := 'HMA not allocated';
  602.     $94 : XMSErrMsg := 'Handler A20 still on';
  603.     $A0 : XMSErrMsg := 'Out of extEnded memory';
  604.     $A1 : XMSErrMsg := 'All XMS handles in use';
  605.     $A2 : XMSErrMsg := 'Invalid handle';
  606.     $A3 : XMSErrMsg := 'Source handle invalid';
  607.     $A4 : XMSErrMsg := 'Source offset invalid';
  608.     $A5 : XMSErrMsg := 'Destination handle invalid';
  609.     $A6 : XMSErrMsg := 'Destination offset invalid';
  610.     $A7 : XMSErrMsg := 'Invalid length for move FUNCTION';
  611.     $A8 : XMSErrMsg := 'Illegal overlapping';
  612.     $A9 : XMSErrMsg := 'Parity error';
  613.     $AA : XMSErrMsg := 'UMB is unlocked';
  614.     $AB : XMSErrMsg := 'UMB is still locked';
  615.     $AC : XMSErrMsg := 'Overflow of UMB lock counter';
  616.     $AD : XMSErrMsg := 'UMB cannot be locked';
  617.     $B0 : XMSErrMsg := 'Smaller UMB available';
  618.     $B1 : XMSErrMsg := 'No more UMB available';
  619.     $B2 : XMSErrMsg := 'Invalid UMB segment address'
  620.   End
  621. End;
  622.  
  623.  
  624. ............................................................
  625. This program below is example for upper include file.
  626.  
  627.  
  628. Uses Dos,Crt,VKeys;
  629.  
  630. {$I VXMS.INC}
  631.  
  632. Type
  633.         SampleData      = Array [1..64000] of Byte;
  634.         ScreenType      = Array [0..200,0..319] of Byte;
  635.         DataPtr         = ^SampleData;
  636.         ScreenPtr       = ^ScreenType;
  637. Const
  638.         XMS_Require     = 1000;
  639. Var
  640.         XMS_Version,XMS_Revision              :Integer;
  641.         HMA_Available                         :Boolean;
  642.         Total_XMS_Free,XMS_Free_Max_Blk       :Integer;
  643.         XMS_Handle                            :Integer;
  644.         XMS_Start_Addr                        :LongInt;
  645.         Data,Blank                            :DataPtr;
  646.         Screen,DataTest                       :ScreenPtr;
  647.         Ch                                    :Char;
  648.         i,j                                   :Word;
  649.  
  650. Begin
  651.   If XMSInitOk Then Begin
  652.     Writeln ('XMS Driver detected');
  653.     XMSQueryVerHMA (XMS_Version,XMS_Revision,HMA_Available);
  654.     Writeln ('XMS Driver Version ',XMS_Version div 100,
  655.              '.',XMS_Version mod 100);
  656.     Writeln ('XMS Revision ',XMS_Revision div 100,'.',XMS_Revision mod 100);
  657.     If HMA_Available Then Writeln ('HMA Available');
  658.     XMSQueryFree (Total_XMS_Free,XMS_Free_Max_Blk);
  659.     Dec (Total_XMS_Free,64);
  660.     If XMS_Free_Max_Blk >= Total_XMS_Free Then Dec (XMS_Free_Max_Blk,64);
  661.     Writeln ('XMS Largest free block ',XMS_Free_Max_Blk,' KByte(s)');
  662.     If XMS_Free_Max_Blk < XMS_Require Then  Begin
  663.       Writeln (#7,#13,#10,XMS_Require-XMS_Free_Max_Blk,' KByte(s) XMS memory ',
  664.                'need more.');
  665.       Halt (0)
  666.     End
  667.     Else Begin
  668.       XMSGetMem (XMS_Require,XMS_Handle);
  669.       Writeln ('XMS Allocated');
  670.       XMS_Start_Addr := XMSLock (XMS_Handle);
  671.       XMSUnLock (XMS_Handle);
  672.       New (Data);
  673.       New (Blank);
  674.       For i := 1 to 64000 do Begin
  675.         Data^[i] := (i-1) mod 255;
  676.         Blank^[i] := 0;
  677.       End;
  678.       For i := 1 to Round(XMS_Require/(32000*2/1024)) do
  679.         XMSCopy (0,Longint(Data),XMS_Handle,LongInt(i-1)*1024*50,32000);
  680.       Screen := Ptr ($A000,0);
  681.       New (DataTest);
  682.       XMSCopy (0,LongInt(Data),0,LongInt(DataTest),32000);
  683.       ASM MOV AX,13h; INT 10h End;
  684.       Repeat
  685.         XMSCopy (XMS_Handle,0,0,LongInt(Screen),32000);
  686.         XMSCopy (0,LongInt(Blank),0,LongInt(Screen),32000);
  687.       Until KeyPressed;
  688.       ASM MOV AX,3; INT 10h End;
  689. {      For i := 0 to 199 do
  690.         For j := 0 to 319 do
  691.           Write (DataTest^[i][j]:8);
  692.       Ch := ReadKey;}
  693.       XMSFreeMem (XMS_Handle)
  694.     End
  695.   End
  696.   Else Begin
  697.     Writeln (#7,#13,#10,'XMS Driver not load.')
  698.   End
  699. End.
  700.